home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / apel / mule-caesar.el.z / mule-caesar.el
Encoding:
Text File  |  1998-05-21  |  2.9 KB  |  95 lines
  1. ;;; mule-caesar.el --- ROT 13-47 Caesar rotation utility
  2.  
  3. ;; Copyright (C) 1997 Free Software Foundation, Inc.
  4.  
  5. ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
  6. ;; Version: $Id: mule-caesar.el,v 1.3 1997/05/09 02:47:55 morioka Exp $
  7. ;; Keywords: ROT 13-47, caesar, mail, news, text/x-rot13-47
  8.  
  9. ;; This file is part of APEL (A Portable Emacs Library).
  10.  
  11. ;; This program is free software; you can redistribute it and/or
  12. ;; modify it under the terms of the GNU General Public License as
  13. ;; published by the Free Software Foundation; either version 2, or (at
  14. ;; your option) any later version.
  15.  
  16. ;; This program is distributed in the hope that it will be useful, but
  17. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19. ;; General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24. ;; Boston, MA 02111-1307, USA.
  25.  
  26. ;;; Code:
  27.  
  28. (defun char-to-octet-list (character)
  29.   "Return list of octets in code table of graphic character set."
  30.   (let* ((code (char-int character))
  31.      (dim (charset-dimension (char-charset code)))
  32.      dest)
  33.     (while (> dim 0)
  34.       (setq dest (cons (logand code 127) dest)
  35.         dim (1- dim)
  36.         code (lsh code -7))
  37.       )
  38.     dest))
  39.  
  40. (defun mule-caesar-region (start end &optional stride-ascii)
  41.   "Caesar rotation of current region.
  42. Optional argument STRIDE-ASCII is rotation-size for Latin alphabet
  43. \(A-Z and a-z).  For non-ASCII text, ROT-N/2 will be performed in any
  44. case (N=charset-chars; 94 for 94 or 94x94 graphic character set; 96
  45. for 96 or 96x96 graphic character set)."
  46.   (interactive "r\nP")
  47.   (setq stride-ascii (if stride-ascii
  48.              (mod stride-ascii 26)
  49.                13))
  50.   (save-excursion
  51.     (save-restriction
  52.       (narrow-to-region start end)
  53.       (goto-char start)
  54.       (while (< (point)(point-max))
  55.     (let* ((chr (char-after (point)))
  56.            (charset (char-charset chr))
  57.            )
  58.       (if (eq charset 'ascii)
  59.           (cond ((and (<= ?A chr) (<= chr ?Z))
  60.              (setq chr (+ chr stride-ascii))
  61.              (if (> chr ?Z)
  62.              (setq chr (- chr 26))
  63.                )
  64.              (delete-char 1)
  65.              (insert chr)
  66.              )
  67.             ((and (<= ?a chr) (<= chr ?z))
  68.              (setq chr (+ chr stride-ascii))
  69.              (if (> chr ?z)
  70.              (setq chr (- chr 26))
  71.                )
  72.              (delete-char 1)
  73.              (insert chr)
  74.              )
  75.             (t
  76.              (forward-char)
  77.              ))
  78.         (let* ((stride (lsh (charset-chars charset) -1))
  79.            (ret (mapcar (function
  80.                  (lambda (octet)
  81.                    (if (< octet 80)
  82.                        (+ octet stride)
  83.                      (- octet stride)
  84.                      )))
  85.                 (char-to-octet-list chr))))
  86.           (delete-char 1)
  87.           (insert (make-char (char-charset chr)
  88.                  (car ret)(car (cdr ret))))
  89.           )))))))
  90.   
  91.  
  92. (provide 'mule-caesar)
  93.  
  94. ;;; mule-caesar.el ends here
  95.